home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-03 / qbasicpg.zip / BOWLING.BAS < prev    next >
BASIC Source File  |  1989-08-31  |  14KB  |  352 lines
  1. ' BOWLING.BAS
  2. ' This program uses random numbers to simulate a 10-frame bowling game.
  3.  
  4. ' declare subprograms and function
  5.  
  6. DECLARE SUB ScoreCard ()
  7. DECLARE SUB Pause ()
  8. DECLARE FUNCTION GetRandBowl% (values%)
  9. DECLARE SUB ShowBowl (value%)
  10. DECLARE SUB DrawPins (pins%)
  11. DECLARE SUB ProcessSpare (extraBall%, offset%)
  12. DECLARE SUB TenthFrameStrike ()
  13. DECLARE SUB TenthFrameSpare ()
  14.  
  15. ' declare global variables and constants
  16.  
  17. COMMON SHARED total%, strike%, spare%, score$
  18. CONST FRAMEROW% = 3: CONST SCOREROW% = 5
  19. CONST FALSE% = 0, TRUE% = NOT FALSE%
  20.  
  21. RANDOMIZE TIMER      ' seed random number generator with system clock
  22. score$ = "###"       ' template for displaying total% with PRINT USING
  23.  
  24. CLS
  25.  
  26. ScoreCard            ' call ScoreCard to display frames and gutters
  27. DrawPins 10          ' set a fresh rack of 10 pins to start game
  28.  
  29. FOR i% = 1 TO 10     ' for each of the 10 frames...
  30.     Pause            '   pause the action
  31.     DrawPins 10      '   set a fresh rack of 10 pins
  32.  
  33.     firstBowl% = GetRandBowl%(10)  ' get random number for first ball
  34.     strikeDelay% = TRUE%           ' set "strike" flag to true
  35.  
  36.     IF (firstBowl% = 10) THEN      ' if first ball is a strike...
  37.         ShowBowl 10                    ' show a throw that gets 10 pins
  38.         DrawPins 0                     ' show an empty lane
  39.         LOCATE FRAMEROW%, 3 + ((i% - 1) * 6)  ' use i% to locate frame
  40.         PRINT "X"                      ' ...and print "X" for strike
  41.         pinsDown% = 10                 ' set pinsDown% count to 10
  42.         strike% = strike% + 1          ' increment the number of strikes
  43.         noStrikes% = FALSE%            ' set "no strike" flag to false
  44.         
  45.         ' if 3 strikes have been bowled, set flag to process the first
  46.         IF (strike% = 3) THEN strikeDelay% = TRUE% ELSE strikeDelay% = FALSE%
  47.                                   
  48.         ' if working on a spare, calculate score for last frame
  49.         IF (spare%) THEN ProcessSpare firstBowl%, i%
  50.  
  51.     ELSE                           ' if first throw was not a strike...
  52.         ShowBowl firstBowl%            ' show an appropriate throw
  53.         DrawPins 10 - firstBowl%       ' draw the remaining pins
  54.         LOCATE FRAMEROW%, 2 + ((i% - 1) * 6)  ' use i% to locate frame
  55.         PRINT firstBowl%               ' ...and display first ball
  56.  
  57.         ' if working on a spare, calculate score for last frame
  58.         IF (spare%) THEN ProcessSpare firstBowl%, i%
  59.  
  60.         Pause                          ' pause the action
  61.  
  62.         ' get random number for second ball
  63.         secondBowl% = GetRandBowl%(10 - firstBowl%)
  64.         ShowBowl firstBowl% + secondBowl%           ' show the ball
  65.         DrawPins 10 - (firstBowl% + secondBowl%)    ' draw remainder
  66.  
  67.         pinsDown% = firstBowl% + secondBowl%        ' add up pins
  68.         noStrikes% = TRUE%             ' set "no strike" flag to true
  69.         IF (pinsDown% = 10) THEN       ' if two balls make a spare...
  70.             LOCATE FRAMEROW%, 5 + ((i% - 1) * 6)    ' locate frame
  71.             PRINT "/"                      ' ...and print "/" for spare
  72.             spare% = TRUE%                 ' set "spare" flag to true
  73.         ELSE                           ' if not a spare...
  74.             LOCATE FRAMEROW%, 4 + ((i% - 1) * 6)    ' locate frame
  75.             PRINT secondBowl%              ' ...and display second ball
  76.         END IF
  77.     END IF
  78.  
  79.     ' process outstanding strikes if bonus balls are available
  80.  
  81.     IF (strike% >= 1) AND (strikeDelay%) THEN
  82.  
  83.         IF (strike% = 1) THEN      ' if single strike
  84.             total% = total% + 10 + firstBowl% + secondBowl%
  85.             LOCATE SCOREROW%, 3 + ((i% - 2) * 6) ' locate last frame
  86.             PRINT USING score$; total%           ' print total score
  87.             strikeDelay% = FALSE%      ' set "strike" flag to false
  88.         END IF
  89.  
  90.         IF (strike% = 2) OR (strike% = 3) THEN  ' if double or triple
  91.             total% = total% + 10 + 10 + firstBowl%  ' total pins
  92.             LOCATE SCOREROW%, 3 + ((i% - 3) * 6)    ' move 2 frames back
  93.             PRINT USING score$; total%              ' print total score
  94.             IF (noStrikes%) THEN   ' if all bonus balls available
  95.                 total% = total% + 10 + firstBowl% + secondBowl%
  96.                 LOCATE SCOREROW%, 3 + ((i% - 2) * 6)    ' get last frame
  97.                 PRINT USING score$; total%              ' print total score
  98.                 strike% = 0                             ' set number of
  99.             END IF                                      '   strikes to zero
  100.         END IF
  101.  
  102.         strike% = strike% - 1      ' decrement number of strikes
  103.         IF (strike% < 0) THEN strike% = FALSE%  ' don't go below zero
  104.     END IF
  105.  
  106.     IF (pinsDown% < 10) AND (NOT strike%) THEN  ' calculate pin total
  107.         total% = total% + pinsDown%             '   for open frame
  108.         LOCATE SCOREROW%, 3 + ((i% - 1) * 6)    '   and display score
  109.         PRINT USING score$; total%
  110.     END IF
  111.  
  112. NEXT i%
  113.  
  114. IF (strike%) THEN TenthFrameStrike ' if a strike in the 10th frame
  115.  
  116. IF (spare%) THEN TenthFrameSpare   ' if a spare in the 10th frame
  117.  
  118. END                                ' end main program
  119.  
  120. SUB DrawPins (num%)
  121.  
  122. ' DrawPins displays the number of pins specified by num%.
  123. '   CHR$(173) is an upside-down exclamation mark from the
  124. '   IBM extended character set used to represent a pin.
  125.  
  126. COLOR 14         ' set color to yellow
  127.  
  128. LOCATE 21, 70    ' this is the last pin to be knocked down
  129. IF (num% = 10) THEN PRINT CHR$(173) ELSE PRINT " "
  130.  
  131. LOCATE 20, 68
  132. IF (num% >= 9) THEN PRINT CHR$(173) ELSE PRINT " "
  133.  
  134. LOCATE 19, 66
  135. IF (num% >= 8) THEN PRINT CHR$(173) ELSE PRINT " "
  136.  
  137. LOCATE 19, 70
  138. IF (num% >= 7) THEN PRINT CHR$(173) ELSE PRINT " "
  139.  
  140. LOCATE 18, 68
  141. IF (num% >= 6) THEN PRINT CHR$(173) ELSE PRINT " "
  142.  
  143. LOCATE 18, 64
  144. IF (num% >= 5) THEN PRINT CHR$(173) ELSE PRINT " "
  145.  
  146. LOCATE 17, 66
  147. IF (num% >= 4) THEN PRINT CHR$(173) ELSE PRINT " "
  148.  
  149. LOCATE 16, 68
  150. IF (num% >= 3) THEN PRINT CHR$(173) ELSE PRINT " "
  151.  
  152. LOCATE 17, 70
  153. IF (num% >= 2) THEN PRINT CHR$(173) ELSE PRINT " "
  154.  
  155. LOCATE 15, 70    ' this is the first pin to be knocked down
  156. IF (num% >= 1) THEN PRINT CHR$(173) ELSE PRINT " "
  157.  
  158. COLOR 7          ' set color back to white
  159.  
  160. END SUB
  161.  
  162. FUNCTION GetRandBowl% (values%)
  163.  
  164. ' GetRandBowl% returns a random number between 1 and values% to
  165. '   the calling procedure.
  166.  
  167. GetRandBowl% = INT(RND * (values% + 1))
  168.  
  169. END FUNCTION
  170.  
  171. SUB Pause
  172.  
  173. ' Pause returns the ball to the top of the lane and pauses the action.
  174.  
  175. FOR ballPos% = 68 TO 3 STEP -1          ' return ball to top of lane
  176.     SOUND 150, .1                       ' play appropriate sound
  177.     LOCATE 12, ballPos%: PRINT CHR$(2)  ' ball is ASCII code number 2
  178.     SOUND 160, .1
  179.     LOCATE 12, ballPos% + 1: PRINT " "
  180.     SOUND 1170, .1
  181. NEXT ballPos%
  182.  
  183. LOCATE 8, 1
  184. COLOR 14, 1                            ' set color to yellow-on-blue
  185. INPUT "Press Enter to bowl ", dummy$   ' pause the action
  186. COLOR 7, 0                             ' return color to defaults
  187.  
  188. LOCATE 12, 3: PRINT " "                ' hide resting place of ball
  189.  
  190. END SUB
  191.  
  192. SUB ProcessSpare (extraBall%, offset%)
  193.  
  194. ' ProcessSpare calculates the score for the preceeding frame when
  195. '   the extra ball is available.  Offset% is the frame location.
  196.  
  197. total% = total% + 10 + extraBall%          ' calculate frame score
  198. LOCATE SCOREROW%, 3 + ((offset% - 2) * 6)  ' use offset% to get frame
  199. PRINT USING score$; total%                 ' display the total
  200. spare% = FALSE%                            ' set "spare" switch to false
  201.  
  202. END SUB
  203.  
  204. SUB ScoreCard
  205.  
  206. ' ScoreCard displays the bowling scorecard and the alley gutters.
  207.  
  208. COLOR 3                 ' set foreground color to cyan
  209.  
  210. PRINT "   1     2     3     4     5     6     7     8     9     10"
  211. PRINT STRING$(63, "-")
  212. PRINT "|     |     |     |     |     |     |     |     |     |       |"
  213. PRINT "|     |     |     |     |     |     |     |     |     |       |"
  214. PRINT "|     |     |     |     |     |     |     |     |     |       |"
  215. PRINT STRING$(63, "-")
  216.  
  217. LOCATE 13, 5
  218. PRINT STRING$(66, "-")
  219. LOCATE 23, 5
  220. PRINT STRING$(66, "-")
  221.  
  222. COLOR 7                 ' set foreground color to white
  223.  
  224. END SUB
  225.  
  226. SUB ShowBowl (pins%)
  227.  
  228. ' ShowBowl shows the ball rolling down the lane through the pins
  229. '   with appropriate sounds.  The pins% parameter represents the
  230. '   number of pins that should fall and is used to send the ball
  231. '   in the right direction.
  232.  
  233. LOCATE 8, 1                     ' cover up the "Press Enter" message
  234. PRINT SPACE$(20)
  235.  
  236. value% = (pins% + 1) \ 2        ' set target range
  237. IF (value% < 3) AND (value% >= 0) THEN value% = value% + 1
  238. row% = 18                       ' set starting row
  239.  
  240. FOR i% = 2 TO 68 STEP 10        ' roll ball down lane
  241.     FOR j% = 1 TO 10
  242.         SOUND 63, .2            ' play appropriate sound
  243.         LOCATE row%, i% - 1 + j%: PRINT " "   ' cover up tracks
  244.        
  245.         IF (i% > 54) AND (row% <= 18) THEN    ' change sound when in
  246.             FOR k% = 1 TO 5                   '   the pins
  247.                 note% = INT(RND(1) * 150): SOUND 50 + note%, .1
  248.             NEXT k%
  249.         END IF
  250.        
  251.         IF (i% > 61) AND (row% >= 19) AND (row <= 21) THEN
  252.             FOR k% = 1 TO 5
  253.                 note% = INT(RND(1) * 150): SOUND 50 + note%, .1
  254.             NEXT k%
  255.         END IF
  256.  
  257.         SOUND 68, .2
  258.         LOCATE row%, i% + j%: PRINT CHR$(2)   ' display ball
  259.         SOUND 65, .2
  260.     NEXT j%
  261.  
  262.     LOCATE row%, i% - 1 + j%: PRINT " "       ' cover up tracks
  263.     IF (value% >= 5) THEN row% = row% - 1
  264.     row% = row% + 1: value% = value% + 1      ' move to next row
  265. NEXT i%
  266.  
  267. END SUB
  268.  
  269. SUB TenthFrameSpare
  270.  
  271. ' TenthFrameSpare handles the throwing of another ball and the
  272. '   calculation of the 10th frame if there is a spare in the 10th.
  273.  
  274. Pause                            ' pause for extra ball
  275. DrawPins 10                      ' set up a fresh rack of 10 pins
  276. firstBowl% = GetRandBowl%(10)    ' get a random number for extra ball
  277. ShowBowl firstBowl%              ' show the ball rolling down the alley
  278. DrawPins 10 - firstBowl%         ' take away the pins that fell
  279.  
  280. IF (firstBowl% = 10) THEN        ' if the extra ball is a 10 then
  281.     LOCATE FRAMEROW%, 61         '   locate the extra slot
  282.     PRINT "X"                    '   and display an "X" for strike
  283. ELSE
  284.     LOCATE FRAMEROW%, 60         ' if the extra ball is not 10 then
  285.     PRINT firstBowl%             '   print its value in extra slot
  286. END IF
  287.  
  288. ProcessSpare firstBowl%, 11      ' calculate the final value of the
  289.                                  '   10th frame
  290. END SUB
  291.  
  292. SUB TenthFrameStrike
  293.  
  294. ' TenthFrameStrike handles the throwing of two extra balls and any
  295. '   unresolved frames if a strike is bowled in the 10th frame.
  296.  
  297. Pause                           ' pause for first ball
  298. DrawPins 10                     ' set up a fresh rack of 10 pins
  299. firstBowl% = GetRandBowl%(10)   ' get random number for first ball
  300. ShowBowl firstBowl%             ' show the ball rolling down the alley
  301. DrawPins 10 - firstBowl%        ' take away the pins that fell
  302.  
  303. IF (firstBowl% = 10) THEN       ' if the first ball is a 10 then
  304.     LOCATE FRAMEROW%, 59            ' locate the second slot
  305.     PRINT "X"                       ' and display an "X" for strike
  306.  
  307.     IF (strike% = 2) THEN           ' if working on a double,
  308.         total% = total% + 10 + 10 + firstBowl%  ' get last frame total
  309.         LOCATE SCOREROW%, 3 + (8 * 6)           ' locate last frame
  310.         PRINT USING score$; total%              ' record frame score
  311.     END IF
  312.  
  313.     Pause                           ' pause for second ball
  314.     DrawPins 10                     ' set up a fresh rack of 10 pins
  315.     secondBowl% = GetRandBowl%(10)  ' get a random number for ball
  316.     ShowBowl secondBowl%            ' show the ball rolling down the alley
  317.     DrawPins 10 - secondBowl%       ' take away the pins that fell
  318.     IF (secondBowl% = 10) THEN      ' if this ball is also a 10,
  319.         LOCATE FRAMEROW%, 61            ' locate the extra slot
  320.         PRINT "X"                       ' and display an "X" for strike
  321.     ELSE
  322.         LOCATE FRAMEROW%, 60        ' if the ball is not 10 then
  323.         PRINT secondBowl%               ' print its value in extra slot
  324.     END IF
  325. ELSE                            ' if the first ball is not a 10,
  326.     IF (strike% = 2) THEN           ' process the remaining double (if any)
  327.         total% = total% + 10 + 10 + firstBowl%  ' get last frame total
  328.         LOCATE SCOREROW%, 3 + (8 * 6)           ' locate last frame
  329.         PRINT USING score$; total%              ' display frame score
  330.     END IF
  331.  
  332.     secondBowl% = GetRandBowl%(10 - firstBowl%) ' get second ball
  333.     ShowBowl secondBowl% + firstBowl%           ' show ball
  334.     DrawPins 10 - (secondBowl% + firstBowl%)    ' draw remaining pins
  335.     LOCATE FRAMEROW%, 58
  336.     PRINT firstBowl%                            ' display first ball
  337.     IF (secondBowl% + firstBowl% = 10) THEN     ' if 10 down then
  338.         LOCATE FRAMEROW%, 61                        ' print a "/" for
  339.         PRINT "/"                                   ' spare
  340.     ELSE
  341.         LOCATE FRAMEROW%, 60                    ' if less than 10,
  342.         PRINT secondBowl%                           ' print the number
  343.     END IF
  344. END IF
  345.  
  346. total% = total% + 10 + firstBowl% + secondBowl%  ' calculate and
  347. LOCATE SCOREROW%, 57                             '   display final frame
  348. PRINT USING score$; total%
  349.  
  350. END SUB
  351.  
  352.